perm filename MN[GEM,BGB]2 blob sn#093448 filedate 1974-03-25 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	LANGUAGE COMPATIBILITY FLAGS.
C00005 00003	SAIL LIKE SUBROUTINE LINKAGE.
C00009 00004	LINK MACROS
C00012 00005	 NAMES OF NODE DATA WORDS.
C00014 00006	TYPE BIT OPERATIONS.
C00015 00007	PROPERTY-TYPE BITS.
C00017 ENDMK
C⊗;
;LANGUAGE COMPATIBILITY FLAGS.
IFNDEF SAIL,<	↓SAIL←←  0		;-1 FOR SAIL EMBEDDED VERSION.>
IFNDEF LISP,<	↓LISP←←  0		;-1 FOR LISP EMBEDDED VERSION.>
	IFE (SAIL∨LISP){DEFINE EX.{}}
	IFN (SAIL∨LISP){DEFINE EX.{SOSGE ENTERS↑↔JSR EXIT.↑}}

;ALTERNATE PDP-10 MNEMONICS.
	OPDEF DIP[HRLM]↔OPDEF DAP[HRRM]
	OPDEF CAR[HLRZ]↔OPDEF CDR[HRRZ]
	OPDEF LAC[MOVE]↔OPDEF DAC[MOVEM]↔OPDEF GO[JRST]
	OPDEF FLOAT[FSC 233]↔OPDEF FIXX[FIX 233000]

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
	↓P←←17
	↓POP0J.:EX.↔POPJ P,             ↔DEFINE POP0J<GO POP0J.>
	↓POP1J.:EX.↔SUB P,[2(2)]↔GO@2(P)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:EX.↔SUB P,[3(3)]↔GO@3(P)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:EX.↔SUB P,[4(4)]↔GO@4(P)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:EX.↔SUB P,[5(5)]↔GO@5(P)↔DEFINE POP4J<GO POP4J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
	DEFINE ACCUMULATORS(LIST){ACPTR←←2	;DECLARE ACCUMULATORS.
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	FOR @$ I←0,16<AC.$I←I↔>		;ACCUMULATOR NAMES FOR RAID.
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM:0↔>}

;MACROS TO SAVE AND RESTORE AC'S  -  SAVAC, GETAC.
	DEFINE SAVAC $(N){LAC[XWD 2,[AC2: FOR I←2,N{0↔}]]↔BLT AC2+N-2}
	DEFINE GETAC (N){LAC[XWD AC2,2]↔BLT N}

;FATAL ERROR MESSAGE.
	DEFINE FATAL(STR){PUSHJ P,FATAL.↑↔JFCL[ASCIZ|STR|]}
	DEFINE WARNING(STR){PUSHJ P,WARN.↑↔JFCL[ASCIZ|STR|]}
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;SAIL LIKE SUBROUTINE LINKAGE.
	DEFINE CAT $(A,B){A$B}	;CONCATENATION.
	.PLEVEL←←0	;PDL BACK POINTER.
	.SLEVEL←←0	;DEPTH OF NESTED SUBROUTINE DECLARATIONS.

;SUBROUTINE DECLARATION MACROS  -  SUBR & ENDR.
;(Reminder: Right-arrow, "→" is FAIL's macro arg EVAL).
	DEFINE SUBR(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME↔INTERN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↓NAME:IFN(SAIL∨LISP){AOSG ENTERS↑↔JSR ENTRY.↑};}

;SUBN - NOT INTERN'ED SUBROUTINE.
	DEFINE SUBN(NAME,X1,X2,X3,X4,X5)↔{BEGIN NAME
	GLOBAL .PLEVEL↔GLOBAL .SLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL     ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X1>{DEFARG(X1,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X2>{DEFARG(X2,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X3>{DEFARG(X3,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X4>{DEFARG(X4,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1
	IFDIF<><X5>{DEFARG(X5,→.PLEVEL) ↔.PLEVEL←←.PLEVEL+1}}}}}
	XWD 777000+.PLEVEL-CAT(.SBR,→.SLEVEL)-1,[SIXBIT|NAME|]
	↑NAME:IFN(SAIL∨LISP){AOS ENTERS↑};}

;DEFINE ARGUMENT NAME MACRO.
	DEFINE DEFARG(NAME,LEVEL){DEFINE NAME{LEVEL-.PLEVEL(17)}}
;SUBROUTINE TERMINATION MACRO.
	DEFINE ENDR{.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1↔LIT↔BLOCK 0↔BEND }

;SUBROUTINE CALLING MACROS  -  CALL & SETQ.
	DEFINE CALL(NAME,X1,X2,X3,X4,X5)
	{GLOBAL .SLEVEL,.PLEVEL↔.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	IFDIF<><X1>{PUSH P,X1↔.PLEVEL←.PLEVEL+1
	IFDIF<><X2>{PUSH P,X2↔.PLEVEL←.PLEVEL+1
	IFDIF<><X3>{PUSH P,X3↔.PLEVEL←.PLEVEL+1
	IFDIF<><X4>{PUSH P,X4↔.PLEVEL←.PLEVEL+1
	IFDIF<><X5>{PUSH P,X5↔.PLEVEL←.PLEVEL+1 }}}}}
	IFDIF<><NAME>{PUSHJ P,NAME }
	.PLEVEL←←CAT(.SBR,→.SLEVEL)↔.SLEVEL←←.SLEVEL-1}
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;STACK ACCESSING MACROS  -  PUSHP & POPP.
	DEFINE PUSHP(ARG){PUSH P,ARG↔.PLEVEL←←.PLEVEL+1}
	DEFINE POPP(ARG) {POP  P,ARG↔.PLEVEL←←.PLEVEL-1}
;LINK MACROS
	DEFINE LEFT $(NAM,WRD,Z){
	IFIDN<><Z><DEFINE NAM(A,Q)<HLRZ A,WRD(Q)>>
	IFDIF<><Z><DEFINE NAM(A,Q)<HLRE A,WRD(Q)>>
	DEFINE NAM$.(A,Q)<HRLM A,WRD(Q)>}

	DEFINE RIGHT $(NAM,WRD,Z){
	IFIDN<><Z><DEFINE NAM(A,Q)<HRRZ A,WRD(Q)>>
	IFDIF<><Z><DEFINE NAM(A,Q)<HRRE A,WRD(Q)>>
	DEFINE NAM$.(A,Q)<HRRM A,WRD(Q)>}

;DEFINE GEM LINK NAMES.

	LEFT(X1DC,-3,N)↔	RIGHT(Y1DC,-3,N)
	LEFT(X2DC,-2,N)↔	RIGHT(Y2DC,-2,N)
	LEFT(TYPE,0)
	DEFINE $TYPE(Q,E)<LDB Q,[POINT 4,(E),35]>

	LEFT(NFACE,1)↔		RIGHT(PFACE,1)
	LEFT(NED,2)↔		RIGHT(PED,2)
	LEFT(PY,2)↔		RIGHT(NY,2)
	LEFT(NCNT,2,N)
	LEFT(NVT,3)↔		RIGHT(PVT,3)
	LEFT(PTEXT,3)↔		RIGHT(DPSIZ,3,N)
	LEFT(PARRW,3)↔		
	LEFT(NCW,4)↔		RIGHT(PCW,4)
	LEFT(DAD,4)↔		RIGHT(SON,4)
	LEFT(NWRLD,4)↔		RIGHT(PWRLD,4)
	LEFT(NCAMR,4)↔		RIGHT(PCAMR,4)
	LEFT(NCCW,5)↔		RIGHT(PCCW,5)
	LEFT(NTIME,5)↔		RIGHT(PTIME,5)
	LEFT(BRO,5)↔		RIGHT(SIS,5)
	LEFT(ALT,6)↔		RIGHT(ALT2,6)
	RIGHT(FRAME,6)↔		RIGHT(POTEN,6)
	LEFT(CW,7)↔		RIGHT(CCW,7)
	LEFT(SIMAG,7)↔		RIGHT(PIMAG,7)
	LEFT(UFACE,7,N)

	DEFINE XDC(A,B) {HLLE A,1(B)}↔	DEFINE YDC(A,B) {HRLE A,1(B)}
	DEFINE XDC.(A,B){HLLM A,1(B)}↔	DEFINE YDC.(A,B){HLRM A,1(B)}
; NAMES OF NODE DATA WORDS.

	↓AA ←← ↓XWC ←← -3
	↓BB ←← ↓YWC ←← -2
	↓CC ←← ↓ZWC ←← -1

	↓QQ ←← 7
	↓KK ←← 3

	↓XPP ←← 4↔	↓YPP ←← 5↔	↓ZPP ←← 6
	↓IX←←0↔ 	↓IY←←1↔ 	↓IZ←←2
	↓JX←←3↔ 	↓JY←←4↔ 	↓JZ←←5
	↓KX←←6↔ 	↓KY←←7↔ 	↓KZ←←8

;NODE SERIAL TYPE NUMBERS.

	↓$FRAME		←←	0
	↓$EMPTY		←←	1
	↓$UNIVERSE	←←	2
	↓$SUN		←←	3

	↓$CAMERA	←←	4
	↓$WORLD		←←	5
	↓$WINDOW	←←	6
	↓$IMAGE		←←	7

	↓$TEXT		←←	10
	↓$XNODE		←←	11
	↓$YNODE		←←	12
	↓$ZNODE		←←	13

	↓$BODY 		←←	14
	↓$FACE 		←←	15
	↓$EDGE 		←←	16
	↓$VERT 		←←	17
;TYPE BIT OPERATIONS.

	DEFINE MARK(Q,BITS){
	IFE <BITS>⊗-22,{MOVEI BITS}
	IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
	IORM(Q)}

	DEFINE MARKZ(Q,BITS){
	IFE <BITS>⊗-22,{MOVEI BITS}
	IFN <BITS>⊗-22,{MOVSI<BITS>⊗-22}
	ANDCAM (Q)}

	DEFINE TEST(Q,BITS){
	IFDIF<><Q><LAC(Q)>
	IFE <BITS>⊗-22,{TRNN BITS}
	IFN <BITS>⊗-22,{TLNN<BITS>⊗-22}}

	DEFINE TESTZ(Q,BITS){
	IFDIF<><Q><LAC(Q)>
	IFE <BITS>⊗-22,{TRNE BITS}
	IFN <BITS>⊗-22,{TLNE<BITS>⊗-22}}

;PROPERTY-TYPE BITS.
	↓BBIT ←← 1B17		;BODY BIT.
	↓FBIT ←← 1B16		;FACE BIT.
	↓EBIT ←← 1B15		;EDGE BIT.
	↓VBIT ←← 1B14		;VERTEX BIT.

	↓PZZ ←← 1B1		;POSITIVE Z CAMERA COORDINATES.
	↓NZZ ←← 1B10		;NEGATIVE Z IN VIEW.

	↓FOLDED ←← 1B11		;FOLDED EDGE.
	↓VISIBLE ←← 1B12	;ACTUALLY VISIBLE.
	↓POTENT ←← 1B13		;POTENTIALLY VISIBLE.
	↓DARKEN ←← 1B3		;NOT TO BE INTENSIFIED.
	↓NSHARP ←← 1B4		;NOT SHARP - SMOOTH EDGE.

	↓NORTH ←← 1B5		;2-D CLIPPER BITS.
	↓SOUTH ←← 1B6
	↓EAST  ←← 1B7
	↓WEST  ←← 1B8
	↓NSEW  ←← 17B8

	↓JUTBIT ←← 1B3		;JOINT UNDER T.
	↓JOTBIT ←← 1B4		;JOINT OVER T.

	↓TBIT3←←1B20		;TEMPORARY BITS.
	↓TBIT2←←1B19
	↓TBIT1←←1B18
	↓TMPBIT ←← 1B2

	↓BDLBIT ←← 1B1	;BODY OPERATION DISABLE LOCOR ACTION.
	↓BDVBIT ←← 1B3	;BODY OPERATION DISABLE VERTEX ACTION.
	↓BDPBIT ←← 1B4	;BODY OPERATION DISABLE PARTS ACTION.